home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / bin / update-perl-sax-parsers < prev    next >
Encoding:
Text File  |  2010-01-02  |  6.0 KB  |  192 lines
  1. #!/usr/bin/perl
  2. ## ----------------------------------------------------------------------
  3. ## Debian update-perl-sax-parsers version 0.3
  4. ## ----------------------------------------------------------------------
  5. ## Copyright (C) 2001-2003 Ardo van Rangelrooij
  6. ## Copyright (C) 2007      Niko Tyni
  7. ##
  8. ## This is free software; see the GNU General Public Licence version 2
  9. ## or later for copying conditions.  There is NO warranty.
  10. ## ----------------------------------------------------------------------
  11.  
  12. ## ----------------------------------------------------------------------
  13. use strict;
  14.  
  15. ## ----------------------------------------------------------------------
  16. use File::Spec;
  17. use Getopt::Long;
  18. use XML::SAX;
  19. use XML::SAX::Debian;
  20. use File::Temp qw(tempfile);
  21.  
  22. ## ----------------------------------------------------------------------
  23. $0  =~ m|[^/]+$|;
  24.  
  25. ## ----------------------------------------------------------------------
  26. my $name = $&;
  27.  
  28. ## ----------------------------------------------------------------------
  29. my $add       = '';
  30. my @directory = ();
  31. my $file      = '';
  32. my $help      = '';
  33. my $quiet     = '';
  34. my $remove    = '';
  35. my $test      = '';
  36. my $update    = '';
  37. my $version   = '';
  38. my $ucf;
  39. my $priority;
  40.  
  41. ## ----------------------------------------------------------------------
  42. if ( ! GetOptions(
  43.           'add=s'       => \$add,
  44.           'directory=s' => \@directory,
  45.           'file=s'      => \$file,
  46.           'help'        => \$help,
  47.           'quiet'       => \$quiet,
  48.           'remove=s'    => \$remove,
  49.           'test'        => \$test,
  50.           'update'      => \$update,
  51.           'version'     => \$version,
  52.           'priority=i'  => \$priority,
  53.           'ucf=i'       => \$ucf,
  54.           )
  55.      )
  56. {
  57.     &usage;
  58.     exit 1;
  59. }
  60.  
  61.  
  62. ## ----------------------------------------------------------------------
  63. if ( $version )
  64. {
  65.     &version;
  66.     exit 0;
  67. }
  68.  
  69. ## ----------------------------------------------------------------------
  70. if ( $help )
  71. {
  72.     &usage;
  73.     exit 0;
  74. }
  75.  
  76. ## ----------------------------------------------------------------------
  77. print STDERR "$name: test mode - Perl SAX parsers file will not be updated\n"
  78.     if $test && ! $quiet;
  79.  
  80. ## ----------------------------------------------------------------------
  81. # default priority is 50 unless --directory was specified
  82. # with --directory, default to 0 (no priority in the filenames)
  83. $priority = (@directory ? 0 : 50) if not defined $priority;
  84.  
  85. ## ----------------------------------------------------------------------
  86. my $PARSER_DETAILS_DIR  = "/var/lib/libxml-sax-perl/ParserDetails.d";
  87. push( @directory, $PARSER_DETAILS_DIR) if ! @directory;
  88.  
  89. ## ----------------------------------------------------------------------
  90. # use ucf by default if --file is not specified
  91. $ucf  = ($file ? 0 : 1) if not defined $ucf;
  92.  
  93. ## ----------------------------------------------------------------------
  94. my $PARSER_DETAILS_FILE = "/etc/perl/XML/SAX/ParserDetails.ini";
  95. $file = $PARSER_DETAILS_FILE if ! $file;
  96.  
  97. ## ----------------------------------------------------------------------
  98. unless (XML::SAX->can("_is_vendor_supplied")) {
  99.     print STDERR "$name: Non-vendor version of XML::SAX is installed.\n";
  100.     print STDERR "$name: Automatic registration of SAX parsers might not work.\n";
  101. }
  102.  
  103. if ( $add )
  104. {
  105.     print "$name: Registering Perl SAX parser $add with priority $priority...\n"
  106.         unless $quiet;
  107.     
  108.     XML::SAX::Debian->save_parsers_debian( $add, $directory[0], $priority );
  109. }
  110. elsif ( $remove )
  111. {
  112.     print "$name: Unregistering Perl SAX parser $remove with priority $priority...\n"
  113.         unless $quiet;
  114.     
  115.     my $parser_file = $remove;
  116.     $parser_file = "${priority}-$parser_file" if $priority != 0;
  117.     $parser_file = File::Spec->catfile( $directory[0], $parser_file );
  118.     unlink( $parser_file );
  119. }
  120. elsif ( $update )
  121. {
  122.     print "$name: Updating overall Perl SAX parser modules info file...\n"
  123.         unless $quiet;
  124.  
  125.     my ($handle, $tmpfile);
  126.  
  127.     if ($ucf) {
  128.         ($handle, $tmpfile) = tempfile();
  129.         chmod 0644, $tmpfile or die("chmod $tmpfile: $!");
  130.     } else {
  131.         open( $handle, ">$file" )
  132.             || die "Cannot write to $file: $!";
  133.     }
  134.     foreach my $directory ( @directory)
  135.     {
  136.     opendir( PARSER_DETAILS_DIR, $directory )
  137.         || die "Cannot access $directory: $!";
  138.     my @files = sort readdir ( PARSER_DETAILS_DIR );
  139.     for my $parser_details ( @files )
  140.     {
  141.         next if $parser_details =~ /^\.\.?$/; # skip . and ..
  142.         open( PARSER_DETAILS, "$directory/$parser_details" )
  143.         || die "Cannot read from $parser_details: $!";
  144.         while ( <PARSER_DETAILS> ) { print $handle $_; }
  145.         close( PARSER_DETAILS );
  146.     }
  147.     closedir( PARSER_DETAILS_DIR );
  148.     }
  149.     close( $handle );
  150.     if ($ucf) {
  151.         system("ucf --debconf-ok --sum-file /var/lib/libxml-sax-perl/ParserDetails.ini.md5sum $tmpfile $file");
  152.         unlink $tmpfile or die("unlink $tmpfile: $!");
  153.     }
  154. }
  155.  
  156. ## ----------------------------------------------------------------------
  157. exit 0;
  158.  
  159. ## ----------------------------------------------------------------------
  160. sub usage
  161. {
  162.     print STDERR <<END;
  163. Usage:
  164.     $name <options> --add <parser_module>
  165.     $name <options> --remove <parser_module>
  166.     $name <options> --update
  167.  
  168. Options:
  169.     --directory     Perl SAX parser module info file directory to be used
  170.                     as target for 'add'/'remove' or as sources for 'update'
  171.                     (default = '/var/lib/libxml-sax-perl/ParserDetails.d')
  172.     --priority      The priority of the parser to add. The parser with the
  173.                     highest priority is the default parser.
  174.     --file          Perl SAX parser module info file to be updated
  175.                     (default = '/etc/perl/XML/SAX/ParserDetails.ini')
  176.     --ucf X         Forcibly disable (X == 0) or enable (X != 0) the use
  177.                     of ucf with '--update'.
  178.     --help          display this help text (usage)
  179.     --quiet         be quiet
  180.     --test          do not modify any files, enable debugging mode
  181.     --version       display version number
  182. END
  183. }
  184.  
  185. ## ----------------------------------------------------------------------
  186. sub version
  187. {
  188.     print "Debian $name version 0.4\n";
  189. }
  190.  
  191. ## ----------------------------------------------------------------------
  192.